home *** CD-ROM | disk | FTP | other *** search
/ User's Choice Windows CD / User's Choice Windows CD (CMS Software)(1993).iso / win_m_p / pwez51.zip / SCRLRAND.BAS < prev    next >
BASIC Source File  |  1992-04-01  |  16KB  |  343 lines
  1. '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  2. '!!!        ** [ READ THIS ] ** !!!!!!!! ** [ READ THIS ] **             !!!
  3. '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  4. ' DATA FILE, RANDDATA.DAT REQUIRED FOR THIS PROGRAM -- SEE SCRLFILE.DOC
  5. '***************************************************************************
  6. '**   THIS PROGRAM MUST BE USED WITH ONE OF THE FOLLOWING LIBRARIES:      **
  7. '***************************************************************************
  8. '**   For QB4.+ unenhanced version use QB4UNEN.QLB                        **
  9. '**   For BASIC 7.+ unenhanced version use PDSUNEN.QLB                    **
  10. '**   For QB4.50 enhanced version use QBALL45.QLB or QBNER45.QLB          **
  11. '**   For QB4.00/4.00b enhanced version use QBALL40.QLB or QBNER40.QLB    **
  12. '**   For BASIC 7.0 enhanced version use PDSALL70.QLB or PDSNER70.QLB     **
  13. '**   For BASIC 7.1 enhanced version use PDSALL71.QLB or PDSNER71.QLB     **
  14. '**   Load QB or QBX with the /L option using the correct library         **
  15. '***************************************************************************
  16. '                              INSTRUCTIONS
  17. '                              ------------
  18. '   1. MAKE SURE THE DATA FILE, RANDDATA.DAT, IS IN THE CURRENT
  19. '      DRIVE/DIRECTORY.  IF THE DATA FILE IS NOT AVAILABLE IT MAY BE
  20. '      MADE USING MAKERAND.BAS ( SEE SCRLFILE.DOC ).
  21. '   2. LOAD QUICKBASIC OR PDS WITH THE CORRECT LIBRARY. ( SEE ABOVE )
  22. '   3. LOAD SCRLRAND.BAS ( THIS PROGRAM ) INTO QB OR QBX.
  23. '   4. RUN THE PROGRAM. ( SHIFT F5 )
  24. '
  25. '          **** SEE SCRLFILE.DOC FOR ADDITIONAL INFORMATION ****
  26. '***************************************************************************
  27. COLOR 0, 7: CLS
  28.  
  29. CALL SETWIND(1, 1, 0)              ' INITIALIZE WINDOW MEMORY.
  30. CALL INPTINIT(1, 1, "")            ' INITIALIZE INPUT MEMORY.
  31. CALL SETSCRL(1, 0, 15)             ' HI-INTENSITY TAG CHARACTER.
  32.  
  33. DO
  34.   ANS$ = ""
  35.   CALL GETANS("Color or Mono (C/M) ?", "CM", ANS$, 100, 100, 143, 11)
  36.   IF ANS$ = "C" THEN COL% = 23 ELSE COL% = 112
  37. LOOP WHILE ANS$ = CHR$(27)
  38.  
  39. IF COL% = 23 THEN A% = 31 ELSE A% = 15
  40. CALL INFOLINE(25, 1, 80, A%)              ' TURN INFO-LINE ON.
  41.  
  42. CALL MOUSEON(1)                           ' TURN THE MOUSE ON.
  43. CALL MBUTTONS(13, 27)                     ' RIGHT MOUSE BUTTON = ENTER
  44.                                           ' LEFT MOUSE BUTTON = ESC
  45. '---------------------------------------------------------------------------
  46. ' DESCRIPTION WINDOW
  47.  
  48. CALL MAKEWIND(2, "@Virtual scroll window template - Using random file access", 2, 100, 74, 8, COL%, 111)
  49.  CALL PRINTW("This scroll window scrolls through a random access file.    It holds 7", 1, 2)
  50.  CALL PRINTW("records at a time.   This eliminates the need to place the entire file", 2, 2)
  51.  CALL PRINTW("in memory, minimizing precious string space usage.   This template may", 3, 2)
  52.  CALL PRINTW("be used with binary or indexed files with slight modification.", 4, 2)
  53. '---------------------------------------------------------------------------
  54. ' MAKE THE WINDOW TO BE USED AS THE SCROLL WINDOW.
  55. ' INITIALIZE VARIABLES
  56.  
  57.  
  58. CALL MAKEWIND(1, "", 12, 100, 74, 11, COL%, 111)   ' WINDOW WITH 11 ROWS
  59.  
  60. FILEPOINTER = 1          ' START AT RECORD# 1.
  61. RTRN% = 1                ' SCROLL BAR OVER 1ST ENTRY.
  62. ROWS% = 7                ' INTERIOR ROWS IN SCROLL WINDOW.
  63.                          ' IF WINDOW HAS A TITLE BOX ROWS% = NUMBER OF
  64.                          ' WINDOW ROWS - 4 ELSE ROWS% = NUMBER OF WINDOW
  65.                          ' ROWS - 2.
  66. DIM A$(ROWS%)            ' DIMENSION ARRAY TO HOLD SCROLL WINDOW ENTRIES.
  67. FC% = 1                  ' THE FIRST CHARACTER FOR ENTRIES IN SCROLL WINDOW
  68.                          ' PRINTS IN THE FIRST COLUMN IN THE WINDOW.
  69.                          ' WITH VIRTUAL SCROLL WINDOWS THE CHARACTER IN THE
  70.                          ' 1st COLUMN IS NOT ALWAYS THE 1st CHARACTER.
  71. DATAFILE$ = "RANDDATA.DAT"   ' DATA FILE
  72. FILENUM% = 1                 ' USE FILE NUMBER 1
  73. DIM DUMMY$(0)                ' SCROLL WINDOW REQUIRES THIS FOR INFOLINE
  74.  
  75. TYPE RECORDTYPE          ' PLACE YOUR OWN TYPE HERE
  76.   MARK AS STRING * 1
  77.   NAM AS STRING * 25
  78.   ADD1 AS STRING * 30
  79.   CITY AS STRING * 25
  80.   STATE AS STRING * 10
  81.   ZIP AS STRING * 9
  82. END TYPE
  83. DIM RECORD AS RECORDTYPE
  84.  
  85. RECORDLEN% = LEN(RECORD)
  86.  
  87. ' SCROLL WINDOW'S TITLE
  88. TITLE$ = "NAME                     ADDRESS                       CITY                     STATE     ZIP"
  89.  
  90. ' --------------------------------------------------------------------------
  91.  ' FIND THE NUMBER OF RECORDS IN THE FILE BASED ON THE RECORD LENGTH.
  92.  
  93. OPEN DATAFILE$ FOR RANDOM AS FILENUM% LEN = RECORDLEN%
  94.   MAXENTRIES = LOF(1) / RECORDLEN%
  95. CLOSE
  96.  
  97. OPEN DATAFILE$ FOR RANDOM AS FILENUM% LEN = RECORDLEN%
  98.  
  99. GETFILE:
  100.   GOSUB GETRECORDS
  101.  
  102. ' ---------------------------------------------------------------------------
  103.  ' PRINT THE INSTRUCTIONS AND PLACE THE RECORDS IN THE SCROLL WINDOW.
  104.  
  105. MAKESCRL:
  106.   IF ENTRIES% < 1 THEN CALL PRINTW("No entries..", 1, 100): END
  107.   CALL NEWCOLOR(15)
  108.   CALL PRINTW("[ <ENTER>=Select  <F1>=Find   <+>=Mark   <->=Unmark  <ESC>=Quit ]", 8, 100)
  109.   CALL NEWCOLOR(COL%)
  110.  
  111.   ' KIND$ REPRESENTS TYPE OF SCROLL WINDOW ON ENTRY AND THE MARKED ENTRIES
  112.   ' ON EXIT.
  113.   ' SET KIND$ TO "M" TO MAKE A "MARKED" SCROLL WINDOW.
  114.  
  115.   CALL INFOFIXED("     Up/Down/Left/Right -- Pgup/Pgdn -- Home/End -- Tab/Shift Tab -- Mouse")
  116.   KIND$ = "M"         ' THIS IS A "MARK" SCROLL WINDOW.
  117.  
  118.   CALL B4SCRL("1REX", SCROLLMARK$)   ' SET EXIT CRITERIA AND MARKED ENTRIES.
  119.  
  120.   ' ENTER THE SCROLL WINDOW
  121.  
  122.   CALL SCRLWIND(A$(), DUMMY$(), TITLE$, ENTRIES%, KIND$, RTRN%, LI%, FC%, RK%, 0)
  123.   CALL INFOFIXED("")                   ' ERASE THE FIXED INFO STRING.
  124. '----------------------------------------------------------------------------
  125.  ' RK% = 50 IF THE + OR INSERT (MARK) KEY CAUSED THE EXIT.
  126.  ' RK% = 55 IF THE - OR DELETE (UN-MARK) KEY CAUSED THE EXIT.
  127.  ' KIND$ HOLDS THE CODED STRING FOR MARKED ITEMS ON EXIT.
  128.  ' SET SCROLLMARK$ TO KIND$ FOR NEXT ENTRY INTO SCROLL WINDOW.
  129.  ' NOTE: REQUIRES A FIELD IN THE DATABASE RESERVED FOR THE MARK FLAG.
  130.  
  131.  SELECT CASE RK%
  132.    '( KIND$ RETURNED BY SCRLWIND -- REPRESENTS MARKED ITEMS )
  133.  
  134.    CASE 50, 55       '+/INSERT FOR MARK OR -/DELETE FOR UNMARK CAUSED EXIT
  135.  
  136.      IF ONLAST% = 1 THEN                          ' MOVE FILEPOINTER TO
  137.         FILEPOINTER = FILEPOINTER - ENTRIES% + 1  ' 1ST RECORD IN SCROLL
  138.         ONLAST% = 0                               ' WINDOW.
  139.      END IF
  140.  
  141.     IF KIND$ = "" THEN                         'NOTHING MARKED
  142.       RECORD.MARK = " ": SCROLLMARK$ = SPACE$(ENTRIES%)
  143.     ELSE                                       ' AT LEAST ONE ENTRY MARKED
  144.       RECORD.MARK = MID$(KIND$, RTRN%, 1): SCROLLMARK$ = KIND$
  145.     END IF
  146.  
  147.     PUT 1, FILEPOINTER + RTRN% - 1, RECORD.MARK   ' PUT MARK FLAG IN CORRECT
  148.                                                   ' RECORD IN FILE.
  149.     RTRN% = RTRN% + 1                             ' ADVANCE TO NEXT RECORD.
  150.     IF RTRN > ENTRIES% THEN RK% = 19: GOTO DOWN   ' ELSE ACT LIKE DOWN ARROW
  151. '---------------------------------------------------------------------------
  152.  ' THE ESC KEY CAUSED THE EXIT FROM THE SCROLL WINDOW
  153.  
  154.    CASE 27
  155.      CALL PRINTW(STRING$(66, 196), 8, 100)
  156.      CALL PRINTINFO(" Press Y to quit or N to continue.  Press ENTER to accept..")
  157.      ANS$ = "N"
  158.      CALL GETANS("Quit (Y/N) ", "YN", ANS$, 14, 100, 1112, 11)
  159.      IF ANS$ = "Y" THEN CLOSE : CLS : END
  160.  
  161. '---------------------------------------------------------------------------
  162. ' THE ENTER KEY CAUSED THE EXIT ---- AN ENTRY WAS SELECTED.
  163. ' USING MULTINPT THE RECORD COULB BE EDITED HERE.
  164.  
  165.    CASE 13
  166.      IF ONLAST% = 1 THEN                          ' SET FILE POINTER TO THE
  167.         FILEPOINTER = FILEPOINTER - ENTRIES% + 1  ' 1ST RECORD IN WINDOW.
  168.         ONLAST% = 0
  169.      END IF
  170.      '( SELECTED RECORD = FILEPOINTER + RTRN% - 1 )
  171.  
  172.      CALL PRINTW(STRING$(66, 196), 8, 100)
  173.      CALL PRINTINFO(" Press any key to continue.......... ")
  174.      CALL GETANS("Selection was record number:" + STR$(FILEPOINTER + RTRN% - 1), "", "", 14, 100, 15, 11)
  175.  
  176. '---------------------------------------------------------------------------
  177. ' THE HOME KEY CAUSED THE EXIT
  178.  
  179.  CASE 30
  180.     FC% = 1                     ' START WITH 1ST CHARACTER IN 1ST COLUMN
  181.     FILEPOINTER = 1             ' START AT RECORD 1
  182.     RTRN% = 1                   ' SCROLL BAR ON 1ST RECORD IN SCROLL WINDOW.
  183.     GOSUB GETRECORDS            ' FILL A$() WITH THE RECORDS
  184.  
  185. '---------------------------------------------------------------------------
  186. ' THE END KEY CAUSED THE EXIT
  187.  
  188.  CASE 35
  189.     FC% = 1                                  ' 1ST CHARACTER IN 1ST COLUMN
  190.     FILEPOINTER = MAXENTRIES - ROWS% + 1     ' LAST "ROWS%" OF RECORDS
  191.     IF FILEPOINTER < 1 THEN FILEPOINTER = 1  ' ADJUST IF < 1
  192.     GOSUB GETRECORDS                         ' GET RECORDS TO FILL WINDOW
  193.     RTRN% = ENTRIES%                         ' SCROLL BAR ON LAST RECORD
  194.  
  195. '---------------------------------------------------------------------------
  196. ' THE F1 KEY ( FIND ) CAUSED THE EXIT
  197.  
  198.  CASE 1
  199.  
  200.    DO
  201.       CALL DOSOUND
  202.       RTRN$ = ""
  203.       CALL PRINTW(STRING$(66, 196), 8, 100)
  204.       CALL PRINTINFO(" Input a record number.  Press ENTER to accept or ESC to abort.")
  205.       CALL INPTWIND("FIND RECORD NUMBER ( 1 TO" + STR$(MAXENTRIES) + " ): ", "0", 100, 100, 3, 15, "", RTRN$, RKEY%, 11)
  206.       REC = VAL(RTRN$)
  207.       ' CHECK FOR PROPER RANGE FOR INPUT
  208.     LOOP WHILE (REC < 1 OR REC > MAXENTRIES) AND RKEY% <> 27
  209.  
  210.     CALL RSTRINPT(1)                                 ' RESTORE INPUT WINDOW.
  211.     IF RKEY% = 27 THEN GOTO MAKESCRL                 ' ESC WAS PRESSED.
  212.  
  213. GOTREC:
  214.     IF ONLAST% = 1 THEN                              ' FILE POINTER TO
  215.         FILEPOINTER = FILEPOINTER - ENTRIES% + 1     ' 1ST RECORD IN WINDOW.
  216.           ONLAST% = 0
  217.     END IF
  218.  
  219.     FC% = 1                                     ' 1ST CHARACTER IN 1ST COLUMN.
  220.     OLDREC = FILEPOINTER                        ' SAVE THE OLD FILEPOINTER.
  221.     FILEPOINTER = REC                           ' SET FILEPOINTER TO ENTERED
  222.                                                 ' RECORD.
  223.  
  224.     IF REC <= ROWS% THEN                        ' RECORD = 1 TO ROWS%
  225.       RTRN% = REC                               ' SCROLL BAR ON ENTERED RECORD
  226.       FILEPOINTER = 1                           ' 1ST RECORD = 1ST WIND. ENTRY
  227.     ELSEIF REC > MAXENTRIES - ROWS% THEN        ' RECORD = MAXENTRIES - ROWS%
  228.       RTRN% = ROWS% - (MAXENTRIES - REC)        ' TO MAXENTRIES.
  229.       FILEPOINTER = MAXENTRIES - ROWS% + 1      ' JUST LIKE "END".
  230.     ELSEIF REC >= OLDREC AND REC <= OLDREC + ROWS% - 1 THEN
  231.       FILEPOINTER = OLDREC                      ' RECORD IN PRESENT WINDOW
  232.       RTRN% = (REC - OLDREC + 1)
  233.     ELSE                                     ' RECORD = ALL OTHERS.
  234.       RTRN% = 1                              ' SCROLL BAR ON 1ST WIND ENTRY.
  235.       FILEPOINTER = REC                      ' ENTRERED RECORD 1ST IN WIND.
  236.     END IF
  237.     GOSUB GETRECORDS                         ' GO GET CORRECT RECORDS
  238.  
  239. ' ---------------------------------------------------------------------------
  240. ' SCRLWIND EXIT WAS CAUSED BY ATTEMPT TO MOVE PAST THE END OF
  241. ' THE SCROLL WINDOW ( A$(ENTRIES%) ).  PROGRAM ALSO MOVES HERE IF
  242. ' Mark (+) /Un-mark (-)  WAS PRESSED ON THE LAST ENTRY IN THE SCROLL
  243. ' WINDOW.
  244.  
  245.  CASE 12, 19                                    ' SCROLLING PAST THE END OF
  246.                                                 ' LIST IN THE SCROLL WINDOW.
  247. DOWN:
  248.  
  249.     IF ONLAST% = 0 THEN                         ' IF FILE POINTER IS ON
  250.        FILEPOINTER = FILEPOINTER + ENTRIES% - 1 ' FIRST ENTRY IN THE SCROLL
  251.        ONLAST% = 1                              ' WINDOW MOVE IT TO THE
  252.     END IF                                      ' LAST ENTRY.
  253.       
  254.     IF LI% = ENTRIES% AND FILEPOINTER + 1 > MAXENTRIES THEN   ' END OF FILE?
  255.        RTRN% = ENTRIES%
  256.        CALL DOSOUND                             ' MAKE BEEP AND DO NOTHING
  257.     ELSE                                        ' NOT END OF FILE
  258.        IF ENTRIES% = ROWS% THEN
  259.           FILEPOINTER = FILEPOINTER + 1         ' INCREMENT FILEPOINTER
  260.           IF RK% = 12 THEN                                 ' PAGE DOWN
  261.              IF FILEPOINTER + ROWS% - 1 > MAXENTRIES THEN  ' END OF FILE?
  262.                 FILEPOINTER = MAXENTRIES - ROWS% + 1       ' JUST LIKE "END"
  263.              END IF
  264.              GOSUB GETRECORDS                     ' PUT RECORDS IN A$()
  265.           ELSE                                    ' MUST BE DOWN ARROW.
  266.              FOR X% = 1 TO ROWS% - 1              ' SHIFT SCROLL ENTRIES
  267.                 SWAP A$(X%), A$(X% + 1)           ' UP ONE.
  268.              NEXT
  269.              GET 1, FILEPOINTER, RECORD           ' GET NEW LAST ENTRY.
  270.              A$(ENTRIES%) = RECORD.NAM + RECORD.ADD1 + RECORD.CITY + RECORD.STATE + RECORD.ZIP
  271.  
  272.              'FIX STRING REPRESENTING "MARKED" ENTRIES
  273.              SCROLLMARK$ = RIGHT$(SCROLLMARK$, ENTRIES% - 1) + RECORD.MARK
  274.           END IF
  275.        END IF
  276.     END IF
  277.     RTRN% = ENTRIES%
  278. '----------------------------------------------------------------------------
  279. ' SCRLWIND EXIT WAS CAUSED BY AN ATTEMPT TO MOVE BEFORE THE FIRST
  280. ' ENTRY ( A$(START) ) IN THE SCROLL WINDOW.
  281.  
  282.  CASE 11, 16                                  ' SCROLLING BEFORE START OF
  283.                                               ' LIST IN SCROLL WINDOW
  284.  
  285.     IF ONLAST% = 1 THEN                        ' IF FILEPOINTER = LAST SCROLL
  286.       FILEPOINTER = FILEPOINTER - ENTRIES% + 1 ' WINDOW ENTRY SET TO FIRST.
  287.       ONLAST% = 0
  288.     END IF
  289.  
  290.     IF LI% = 1 AND FILEPOINTER = 1 THEN         ' FIRST RECORD IN FIRST ROW.
  291.       CALL DOSOUND                              ' CAN'T MOVE UP.
  292.     ELSE
  293.       IF ENTRIES% = ROWS% THEN
  294.          IF RK% = 11 THEN                       ' MUST BE PAGE UP.
  295.             FILEPOINTER = FILEPOINTER - ROWS%         ' MOVE UP ONE PAGE OF "RECORDS"
  296.             IF FILEPOINTER < 1 THEN FILEPOINTER = 1   ' BEFORE FIRST RECORD?
  297.             GOSUB GETRECORDS                          ' PUT RECORDS IN A$()
  298.          ELSE                                ' MUST BE UP ARROW.
  299.             FILEPOINTER = FILEPOINTER - 1    ' MOVE POINTER UP ONE IN FILE.
  300.             FOR X% = ROWS% TO 2 STEP -1      ' SHIFT RECORDS IF SCROLL LIST.
  301.                SWAP A$(X%), A$(X% - 1)
  302.             NEXT
  303.             GET 1, FILEPOINTER, RECORD       ' GET A NEW FIRST RECORD
  304.             A$(1) = RECORD.NAM + RECORD.ADD1 + RECORD.CITY + RECORD.STATE + RECORD.ZIP
  305.  
  306.             'FIX STRING REPRESENTING "MARKED" ENTRIES
  307.             SCROLLMARK$ = RECORD.MARK + LEFT$(SCROLLMARK$, ENTRIES% - 1)
  308.          END IF
  309.       END IF
  310.     END IF
  311.     LIN% = 1: RTRN% = 1
  312.  
  313.  END SELECT
  314.  GOTO MAKESCRL
  315.  
  316. '---------------------------------------------------------------------------
  317. ' READ RECORDS FROM THE FILE. READ UNTIL MAXIMUM NUMBER OF ENTRIES
  318. ' IN THE SCROLL WINDOWS ( ROWS% ) IS REACHED, OR UNTIL THE END
  319. ' OF FILE ( MAXENTRIES% ) IS REACHED.
  320.  
  321. GETRECORDS:
  322.   SCROLLMARK$ = SPACE$(ROWS%)        ' MAKE STRING TO REPRESENT "MARKED" ENTRIES.
  323.   ENTRIES% = 0                       ' ENTRIES IN SCROLL WINDOW.
  324.   WHILE ENTRIES% < ROWS% AND FILEPOINTER <= MAXENTRIES
  325.     ENTRIES% = ENTRIES% + 1          ' INCREMENT ENTRIES.
  326.     GET 1, FILEPOINTER, RECORD       ' GET RECORD FROM THE FILE
  327.     FILEPOINTER = FILEPOINTER + 1    ' MOVE TO NEXT RECORD
  328.  
  329.     ' MAKE AN ENTRY IN THE SCROLL WINDOW
  330.     A$(ENTRIES%) = RECORD.NAM + RECORD.ADD1 + RECORD.CITY + RECORD.STATE + RECORD.ZIP
  331.  
  332.     ' SET STRING REPRESENTING "MARKED" ENTRIES
  333.     MID$(SCROLLMARK$, ENTRIES%, 1) = RECORD.MARK
  334.   WEND
  335.   FILEPOINTER = FILEPOINTER - 1           ' ADJUST TO LAST RECORD IN SCROLL WINDOW.
  336.   ONLAST% = 1                             ' SET FLAG TO SHOW FILE POINTER IS
  337.                                           ' ON LAST RECORD IN SCROLL WINDOW.
  338.   SCROLLMARK$ = LEFT$(SCROLLMARK$, ENTRIES%)  ' MAKE IT THE CORRECT LENGTH
  339.                                               ' REQUIRED WHEN ENTRIES% < ROWS%
  340. RETURN
  341. '----------------------------------------------------------------------------
  342.  
  343.